<%
' +----------------------------------------------------------------------
' | POPASP [ ASP MVC ]
' +----------------------------------------------------------------------
' | Copyright (c) 2016 http://popasp.com All rights reserved.
' +----------------------------------------------------------------------
' | Licensed ( http://www.apache.org/licenses/LICENSE-2.0 )
' +----------------------------------------------------------------------
' | Author: popasp <1737025626@qq.com>
' +----------------------------------------------------------------------

' 输出变量
Sub var_export ( arg )
	Easp.wn Easp.Encode( arg )
End Sub

'//三目运算,表达式，返回值1，返回值2
Function iif(a,b,c)
  If a Then iif=b Else iif=c End IF
End Function

' 控制器的跳转
Sub A_(url)
	Call POP_MVC.Action(url)
End Sub

'得到模型对象
Function M_( tableName )
	Set M_ = POP_MVC.Model( tableName )
End Function


'获取/设置属性值，并非 Cookie,而是POP_MVC.config
Function C_(key)
	if isArray( key ) Then
		POP_MVC.config(key(0)) = key(1)
	elseif TypeName(key)="Dictionary" Then	'如果分配的是Dictionary对象则设置config
		set POP_MVC.config = POP_MVC.dict.Merge(POP_MVC.config,key)
	else
		C_ = POP_MVC.getConfig(key)
	End If
End Function

'读取/设置session
Function S_(key)
	dim i,rs,dict,k
	if isArray( key ) Then		'如果为数组，第一个元素是键名，第二个元素是值
		if isNull(key(1)) Then	'如果第二个元素为null,则删除该键值对
			call session.Contents.Remove( key(0) )
		elseif typename(key(1)) = "Recordset" Then
			set session( key(0) ) = POP_MVC.rs2dict( key(1) )
		elseif typename(key(1)) = "Dictionary" Then
			set session( key(0) ) = key(1)
		else
			if isObject( key(1) )  Then
				set session( key(0) ) = key(1)
			else 
				session( key(0) ) = key(1)
			End If
		End If		
	elseif typename(key) = "Recordset" Then
		set rs = key
		for i = 0 to rs.fields.count-1
			session( rs.fields(i).Name ) = rs.fields(i).Value
		next
	elseif typename(key) = "Dictionary" Then
		set dict = key
		for each k in dict
			if isNull( dict(k) ) then
				call session.Contents.Remove( k )
			else
				session( k ) = dict( k )
			end if
		next		
	elseif isNull(key) then
		session.Contents.RemoveAll	
	else
		if isObject( session(key) ) Then
			set S_ = session(key)
		else
			S_ = session(key)
		end If
	End If
End Function


'创建Dictionary对象
Function D_()
	Set D_ = POP_MVC.CreateDict()
End Function

' 实例化MVC的核心类
Function P_( ctrl )
	ctrl = UCase(ctrl)
	if left(ctrl,7) <> "POPASP_" Then
		ctrl = "POPASP_" & ctrl 
	End If
	Set P_ = POP_MVC.import( ctrl )
End Function

' 得到Dictionary自动增长的键名，从"0"开始，如果要初始化键名 POP_MVC.unset "K_"
Function K_()
	K_ = POP_MVC.getDictAutoKey()
End Function

' 记录和统计时间（微秒）和内存使用情况
' 使用方法:
' <code>
' G_("begin") ' 记录开始标记位
' ' ... 区间运行代码
' G_("end") ' 记录结束标签位
' Response.Write G_( array("begin","end",3) ) ' 统计区间运行时间 精确到小数后3位
' </code>
' @param string start 开始标签 args(0)
' @param string end 结束标签 args(1)
' @param integer dec 小数位 args(2)
' @return mixed
Function G_( args )
	if isArray(args) Then
		if isEmpty( POP_MVC.dG_( args(1) ) ) OR isEmpty( POP_MVC.dG_( args(0) ) ) Then
			G_ = "-"
		else
			G_ = POP_MVC.dG_( args(1) ) - POP_MVC.dG_( args(0) )
			
			if ubound(args) > 1 then
				G_ = FormatNumber(G_*1000,args(2),-1,0,0)
			else
				G_ = FormatNumber(G_*1000,0,-1,0,0)
			end if
		end if
	else
		POP_MVC.dG_( args ) = timer()
	end if
End Function

' 设置和获取统计数据
' 使用方法:
' <code>
' N_( Array("db",1) ) // 记录数据库操作次数
' N_("read",1); // 记录读取次数
' Response.Write N_("db") ' 获取当前页面数据库的所有操作次数
' Response.Write N("read") ' 获取当前页面读取次数
' </code> 
' @param string key 标识位置
' @param integer step 步进值
' @return mixed
Function N_(args)
	if isArray(args) Then
		if not POP_MVC.dN_.Exists( args(0) ) Then
			POP_MVC.dN_( args(0) ) = 0
		end if
		if ubound( args ) > 0 then
			POP_MVC.dN_( args(0) ) = POP_MVC.dN_( args(0) ) + args(1)
		else
			POP_MVC.dN_( args(0) ) = POP_MVC.dN_( args(0) ) + 1
		end if
	else
		N_ = POP_MVC.dN_( args )
	end if
End Function

Function F_( args )
	if is_empty( C_("SHOW_PAGE_TRACE") ) then
		exit Function
	end if
	POP_MVC.dFlow.add POP_MVC.dFlow.count,args
End Function

Function L_( str )
	'Exit Function
	if err.Number <> 0 Then
		if str<>"" Then
			L_ =  Now & " " & err.Number & " [" & str  & "] " & " [" & err.Source & "] " & "[" & err.description & "]" 
		else
			L_ =  Now & " " & err.Number & " [" & err.Source & "] " & "[" & err.description & "]" 
		end if
		POP_MVC.Dict.push POP_MVC.dL_,"",L_
		err.clear
	else
		L_ = 0
	End If	
End Function

' 判断类中是否有该方法
Function method_exists( className,method )
	method_exists = P_("POPASP_REJECTION").method_exists(className,method)
End Function

' 执行自定义sub过程
Sub call_user_sub( byval func_name,byval args )
	dim item,str
	
	if typename(args) = "Dictionary" then
		args = args.items
	end if

	if not isArray(args) then
		args = array(args)
	end if
	
	str = ""
	for each item in args
		if TypeName(item) = "String" Then
			str = str & "," & """" & item & """"
		else
			str = str & "," & item
		end if
	next
	str = POP_MVC.ltrim(str,",")
	if str <> "" then
		Execute "Call " & func_name & "( " & str & " )"
	else
		Execute "Call " & func_name & "()"
	end if
End Sub

' 返回自定义函数的Execute字符串
Function call_user_func( byVal var_name,byval func_name,byval args )
	dim item,str
	
	if typename(args) = "Dictionary" then
		args = args.items
	end if
	
	if not isArray(args) then
		args = array(args)
	end if
	
	str = ""
	for each item in args
		if TypeName(item) = "String" Then
			str = str & "," & """" & item & """"
		else
			str = str & "," & item
		end if
	next
	str = POP_MVC.ltrim(str,",")
	var_name = trim(var_name)
	var_name = POP_MVC.rtrim(var_name,"=")
	
	if str <> "" then
		call_user_func = var_name & " = " & func_name & "( " & str & " )"
	else
		call_user_func = var_name & " = " & func_name & "()"
	end if
end function

' 向文件中写入js
Function js_put_contents(byref filePath,byref oJson)
	dim content: content = js_encode( oJson )
	js_put_contents = POP_MVC.file_put_contents(filePath,content)
End Function

' 从文件中读出js字符串
Function js_get_contents(filePath)
	dim obj
	js_get_contents = POP_MVC.file_get_contents( filePath )
	js_get_contents = mid( js_get_contents,7,len(js_get_contents)-10 )
End Function

Function file_get_contents( filePath )
	file_get_contents = POP_MVC.file_get_contents(filePath)
End Function



' 将json解析成Dictionary对象
Function js_encode( byref data )
	dim startTime : startTime = timer()
	
	if typename( data ) = "Recordset" then
		set P_("JSON").data = POP_MVC.rs2dict( data )
	elseif isObject(data) then
		set P_("JSON").data = data
	else
		P_("JSON").data = data
	end if
	js_encode = P_("JSON").JSONoutput
	
	call POP_MVC.pushTime( startTime , "js_encode ( length : " & byte2size(len(js_encode)) & ")" )
End Function

Function js_decode( byVal str )
	dim startTime : startTime = timer()
	if AscB(MidB(str,1,1))=255 and AscB(MidB(str,2,1))=254 Then			
		str = MidB( str, 3 )
	End If
	
	set P_("JSON").data = D_()
	call P_("JSON").loadJSON(str)	
	set js_decode = P_("JSON").data
	call POP_MVC.pushTime( startTime , "js_decode ( length : " & byte2size( len(str) ) & ")" )
End Function


'将byte显示为KB、MB等格式
'如	size = 1024;返回1KB
Function byte2size( size )
	dim i,arr
	size = CDbl(size)    
    if ( 0 = size ) Then
		byte2size = 0
		exit function
	End If
	arr = array("Bytes", "KB", "MB", "GB")
    i = Int( log(size) / log(1024) )
    byte2size = round((size / 1024^i) , 2) & " " & arr(i)
End Function

' Strip HTML and ASP tags from a string 
Function strip_tags(byval fString) 
	Dim re 
	Set re = New RegExp 
	re.IgnoreCase = True 
	re.Global = True
	re.Pattern = "<(.[^>]*)>" 
	fString = re.Replace(fString, "") 
	Set re = Nothing 
	strip_tags = fString 
End Function 

'获取客户端IP地址
Function get_client_ip()  
	Dim strIPAddr  
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then  
	 strIPAddr = Request.ServerVariables("REMOTE_ADDR")  
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then  
	 strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)  
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then  
	 strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)  
	Else  
	 strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")  
	End If  
	get_client_ip = Trim(Mid(strIPAddr, 1, 30))  
End Function 

' URL重定向
' 可只传入url,默认time=0，msg=""，如果想传入多个参数 array(url,time,msg)
' @param string url 重定向的URL地址
' @param integer time 重定向的等待时间（秒）
' @param string msg 重定向前的提示信息
' @return void
sub R_(args)
	on error resume next
    dim str,i,dict,url,time,msg
	set dict = D_	' 非POPASP下把D_换成 Server.CreateObject("Scripting.Dictionary")
	dict(0) = 0		'url
	dict(1) = 0		'time
	dict(2) = ""	'msg
	
	if isArray(args) Then
		for i = 0 to UBound(args)
			dict(i) = args(i)
		next
	else 
		dict(0) = args	'不是数组的话，默认当只传递了url
	end if
	
	url = dict(0) : time = dict(1) : msg = dict(2)
    if msg="" Then msg  = "系统将在" & time & "秒之后自动跳转到" & url & "！"
	
	' 先当没有设置发送时redirect
	if 0 = time Then
		'设置头信息的方法有时候不好使
		'Response.Status = "302 Moved Temporarily"
		'Response.Addheader "Location", url
		Response.redirect url
	else
		Response.AddHeader "REFRESH", time & ";URL=" & url
		if -2147467259<>err.number Then
			Response.write msg
		End if
	end if
	' 如果出错，再当已经设置了发送头再进行redirect
    if -2147467259=err.number  then	'这个错误代码头信息已发送
		str    = "<meta http-equiv='Refresh' content='" & time& ";URL=" & url & "'>"
		if 0<>time then str =  str & msg
		Response.write str
	End If
	call L_("")
End Sub

Function U_( args )
	dim url,reg,matches,c,a,script_name,params,key
	c = POP_MVC.url.get_ctrl_name()
	params = ""		'参数
	if isArray( args ) Then		'如果是数组，U_(array("Index/Find","id=5"))
		url = args(0)
		if ubound( args ) > 0 Then
			if typename( args(1) ) = "Dictionary" Then				
				for each key in args(1)
					params = params & "&" & key & "=" & args(1)(key)
				next
			else
				params = args(1)
			end if
		end if
		params = POP_MVC.String.ltrim(params,"&")
	else
		url = args
	end if
	script_name =  Request.ServerVariables("SCRIPT_NAME")
	set reg = POP_MVC.reg
	reg.Global = true
	reg.IgnoreCase = true
	reg.MultiLine = false
	
	reg.Pattern = "[a-z]\w*"
	if reg.test(url) Then
		a = url
		U_ = script_name & "?" & C_("VAR_MODULE") & "=" & c & "&" & C_("VAR_ACTION") & "=" & a
	End if	
	reg.Pattern = "(\w+)[/\\](\w+)"
	if reg.test(url) Then
		set matches = reg.execute(url)
		c = matches(0).subMatches(0)
		a = matches(0).subMatches(1)
		U_ = script_name & "?" & C_("VAR_MODULE") & "=" & c & "&" & C_("VAR_ACTION") & "=" & a
	End if	
	if params <> "" Then
		U_ = U_ & "&" & params
	end if
	set matches = nothing
End Function

' 判断参数args是否为数组，或者为类数组的Dictionary对象
Function is_array( args )
	dim i,stype : stype = typename( args )
	dim key
	is_array = false
	if isArray(args) Then
		is_array = true
		exit function
	elseif stype = "Dictionary" Then
		i = 0
		for each key in args 
			if key <> i Then
				is_array = false
				exit Function
			End if
			i = i+1
		next
		is_array = true
	else 
		is_array = false
	End If		
End Function

'判断为空
Function is_empty(arg)	
	if isArray( arg ) Then
		if ubound(arg)<0 Then is_empty = true : exit Function
	end if
	if isNumeric(arg) Then
		if arg = 0 Then is_empty = true : exit Function
	End If
	is_empty = false
	select case typename(arg)
		case "Empty","Null","Nothing"
			is_empty = true
		case "Dictionary","IVariantDictionary","IRequestDictionary"
			is_empty = (0 = arg.count)
		case "Recordset"
			is_empty = (0 = arg.RecordCount)
		case "ISessionObject"
			is_empty = (0 = arg.Contents.Count)
		case "String"
			is_empty = ("" = arg)
		case "Boolean"
			is_empty = (false = arg)
		case else
			'其它情况还未发现 
	end Select
End Function

'判断是否为数字
Function is_numeric(arg)
	is_numeric = false
	if isNumeric(arg) Then
		if typename(arg) <> "Boolean" Then
			is_numeric = true
		End If
	end If
End Function

'判断是否本地运行
Function is_localhost()
is_localhost = (Request.ServerVariables("LOCAL_ADDR") = Request.ServerVariables("REMOTE_ADDR"))
End Function

Function md5(str)
	md5 = POP_MVC.String.md5(str)
End Function


Function JSONtoXML(jsonText)
  Dim idx, max, ch, mode, xmldom, xmlelem, xmlchild, name, value

  Set xmldom = CreateObject("Microsoft.XMLDOM")
  xmldom.loadXML "<XML/>"
  Set xmlelem = xmldom.documentElement

  max = Len(jsonText)
  mode = 0
  name = ""
  value = ""
  While idx < max
    idx = idx + 1
    ch = Mid(jsonText, idx, 1)
    Select Case mode
    Case 0 ' Wait for Tag Root
      Select Case ch
      Case "{"
        mode = 1
      End Select
    Case 1 ' Wait for Attribute/Tag Name
      Select Case ch
      Case """"
        name = ""
        mode = 2
      Case "{"
        Set xmlchild = xmldom.createElement("TAG")
        xmlelem.appendChild xmlchild
        xmlelem.appendchild xmldom.createTextNode(vbCrLf)
        xmlelem.insertBefore xmldom.createTextNode(vbCrLf), xmlchild
        Set xmlelem = xmlchild
      Case "["
        Set xmlchild = xmldom.createElement("TAG")
        xmlelem.appendChild xmlchild
        xmlelem.appendchild xmldom.createTextNode(vbCrLf)
        xmlelem.insertBefore xmldom.createTextNode(vbCrLf), xmlchild
        Set xmlelem = xmlchild
      Case "}"
        Set xmlelem = xmlelem.parentNode
      Case "]"
        Set xmlelem = xmlelem.parentNode
      End Select
    Case 2 ' Get Attribute/Tag Name
      Select Case ch
      Case """"
        mode = 3
      Case Else
        name = name + ch
      End Select
    Case 3 ' Wait for colon
      Select Case ch
      Case ":"
        mode = 4
      End Select
    Case 4 ' Wait for Attribute value or Tag contents
      Select Case ch
      Case "["
        Set xmlchild = xmldom.createElement(UCase(name))
        xmlelem.appendChild xmlchild
        xmlelem.appendchild xmldom.createTextNode(vbCrLf)
        xmlelem.insertBefore xmldom.createTextNode(vbCrLf), xmlchild
        Set xmlelem = xmlchild
        name = ""
        mode = 1
      Case "{"
        Set xmlchild = xmldom.createElement(UCase(name))
        xmlelem.appendChild xmlchild
        xmlelem.appendchild xmldom.createTextNode(vbCrLf)
        xmlelem.insertBefore xmldom.createTextNode(vbCrLf), xmlchild
        Set xmlelem = xmlchild
        name = ""
        mode = 1
      Case """"
        value = ""
        mode = 5
      Case " "
      Case Chr(9)
      Case Chr(10)
      Case Chr(13)
      Case Else
        value = ch
        mode = 7
      End Select
    Case 5
      Select Case ch
      Case """"
        xmlelem.setAttribute name, value
        mode = 1
      Case "\"
        mode = 6
      Case Else
        value = value + ch
      End Select
    Case 6
      value = value + ch
      mode = 5
    Case 7
      If Instr("}], " & Chr(9) & vbCr & vbLf, ch) = 0 Then
        value = value + ch
      Else
        xmlelem.setAttribute name, value
        mode = 1
        Select Case ch
        Case "}"
          Set xmlelem = xmlelem.parentNode
        Case "]"
          Set xmlelem = xmlelem.parentNode
        End Select
      End If
    End Select
  Wend

  Set JSONtoXML = xmlDom
End Function

Function getVarType( ByRef num )
	dim ret
	Select case num			
		case 2	'SmallInt
			ret="整形"	
		case 3	'Int
			ret="自动编号(长整型)"	'AutoNumber OR Number
		case 4	'Real
			ret="单精度型"
		case 5	'Float 
			ret="双精度型"
		case 6	'Currency
			ret = "货币"	'Currency
		case 7	'DateTime
			ret = "日期/时间"	'Date/Time
		case 8	'String
			ret = "String"
		case 11	'Bit 
			ret = "是/否" 	'Yes/No
		case 13 'TimeStamp
			ret = "时间戳"
		case 17	'TinyInt
			ret = "字节"
		case 72	'UniqueIdentifier
			ret = "同步复制ID"
		case 128	'Binary
			ret = "二进制"
		case 129	'Char
			ret = "字符型"
		case 130	'NChar
			ret = "NChar"
		case 131	'Decimal
			ret = "小数"
		case 133	'DateTime
			ret = "DateTime"
		case 135	'SmallDateTime
			ret = "SmallDateTime"
		case 200	'VarChar
			ret = "VarChar"
		case 201	'Text
			ret = "Text"
		case 202	'VarChar
			ret = "文本"
		case 203	'备注
			ret = "备注"
		case 204	'Binary
			ret = "Binary"
		case 205	'Image
			ret = "OLE 对象"			
	end Select
	getVarType = ret
End Function
%>